perm filename KK[NEW,LCS] blob sn#561084 filedate 1981-02-01 generic text, type T, neo UTF8
05400		SETZM I		;I=0
05500		MOVEI 1		;N=1
05600		MOVEM N
05700	20	CALL UNSTUF(Q,V,JT)
05900		MOVEI 1,@1(16)	;J=V(N-3)
05920		ADD 1,N
05940		SUBI 1,4
05960		KIFIX 15,(1)	;C GET THE CODE NUM.
06100		KIFIX 11,-1(1)	;NX=V(N-4)-1+N
06200		ADD 11,N	;C HOW FAR DO WE GO FOR THIS ITEM?
06220		SOJ 11,
06300		CAIE 15,=16	;IF(J.EQ.16)GO TO 36
06320		CAIN 15,=8	;IF(J.EQ.8)GO TO 36
06330		JRST S36
06340		CAIN 15,=11	;IF(J.EQ.11)GO TO 36
06350		JRST S36
06360		MOVEI 14,3	;M=3
06380	S22:	CAMN 11,N	;22	IF(N.EQ.NX)GO TO 32
06385		JRST S32
06390		AOJ 14,		;M=M+1
06400		AOS I		;I=I+1
06500		MOVEI 1,@(16)	;L=Q(I)/10000.0
06520		ADD 1,I
06540		MOVE 2,(1)
06560		FDVR 2,[10000.0]
06580		KIFIX 13,2	;AC13 IS L
06600		MOVM 12,13	;C GET THE PARAM NUM.	LL=IABS(L)
06900	S24:	CAMN 12,14	;24	IF(LL.EQ.M)GO TO 21
06920		JRST S21
07000		CAME 11,N	;IF(N.NE.NX)GO TO 25
07020		JRST S25
07050		SOS I		;I=I-1
07075		JRST S32	;GO TO 32
07100	S25:	MOVEI 1,@1(16)
07120		ADD 1,N
07140		SETZM -1(1)	;25	V(N)=0  PUT BACK IN THE ZERO PARAMS.
07350		AOJ 14,		;M=M+1
07400	S23:	AOS N		;23	N=N+1
07500		JRST S24	;GO TO 24
07600	S21:	IMULI 13,=10000	;21	X=Q(I)-L*10000
07620		FLTR 13,13	;C GET BACK THE REAL CONTENTS OF THE PARAM.
07640		MOVEI 1,@(16)
07660		ADD 1,I
07680		FSBR 1,13	;AC1 IS X
07900		MOVEI 2,@1(16)	;V(N)=X
07920		ADD 2,N
07922		MOVEM 1,-1(2)
07950		AOS N		;N=N+1
08000		JRST S22	;GO TO 22
08100	S36:	CAMN 11,N	;36	IF(N.EQ.NX)GO TO 32
08110		JRST S32
08120		MOVE 5,N	;DO 35 K=N,NX-1
08200	S35:	AOS I	;	I=I+1
08210		MOVEI 2,@1(16)	;GET LOC OF V ARRAY
08400		MOVEI 1,@(16)	;LOC OF Q ARRAY  35	V(K)=Q(I)
08410		ADD 2,N
08430		ADD 1,I
08440		MOVE 6,(1)	;Q(I)
08450		MOVEM 6,-1(2)
08460		AOS N
08470		CAME 11,N
08480		JRST S35	;N=NX
08600	S32:	MOVE I
08610		CAMGE @2(16)	;32	IF(I.LT.JT)GO TO 20
08620		JRST S20
08700		MOVE N		;JT=N
08710		MOVEM @2(16)	;GET NEW WD CNT